home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / prepl.src < prev    next >
Text File  |  1991-07-01  |  2KB  |  45 lines
  1. %%HP: T(3)A(R)F(.);
  2. @ by Ted A. Smith
  3. @
  4. @ This routine runs very slow, but seems to work even if there
  5. @ are ML or Code fragments in the program object (which couldn't
  6. @ be said for doing something like: \->STR replacie replacer
  7. @ REPLACE OBJ\->. Is there a saner way?
  8. @
  9. @ If there were routines like GETI, PUTI, etc. which, besides
  10. @ working on lists and arrays, worked on programs, algebraic's,
  11. @ etc. things would be a little easier.
  12. @
  13. DIR
  14.   PRepl  @ <program> <replacies list> <replacers list> => <new program>
  15.     \<< \-> \GaPRepl \GbPRepl
  16.       \<< DUP TYPE
  17.         CASE DUP 8 SAME THEN                 @ for program objects
  18.             DROP Cmp\-> \->LIST
  19.             \<< \GaPRepl \GbPRepl PRepl \>> Each
  20.             OBJ\-> \->LPgm
  21.           END DUP 5 SAME THEN                @ for lists
  22.             DROP
  23.             \<< \GaPRepl \GbPRepl PRepl \>> Each
  24.           END                                @ else, for all others
  25.             DROP \GaPRepl OVER POS
  26.             IF DUP THEN
  27.               SWAP DROP \GbPRepl SWAP GET
  28.             ELSE
  29.               DROP END END \>> \>>
  30.   Each  @ Apply the function in level 1 to each element of the
  31.         @   list or array in level 2
  32.     \<< OVER { }
  33.       IF SAME THEN
  34.         DROP
  35.       ELSE SWAP 1
  36.         DO
  37.           DUP2 GET 4 PICK EVAL PUTI -64
  38.         UNTIL FS? END
  39.       ROT DROP2 END \>>
  40.   Cmp\->.ASC @ \->ASC'ed routine which unpacks programs, algebraics, ...
  41.     "D9D20ECE8112040379C1F3040379C194040379C1B7040379C1B21303471"
  42.   \->LPgm.ASC @ \->ASC'ed routine which repacks a program object
  43.     "D9D2043C8154450B21305CEC"
  44. END
  45.